com!online 2005 May

home *** CD-ROM | disk | FTP | other *** search

/ com!online 2005 May / com_0505_1.iso / opensource / top10 / amc_install.exe / {app} / Scripts / Monsieur Cinéma.ifs < prev next >

Wrap

Text File | 2004-12-10 | 33.1 KB | 772 lines

// GETINFO SCRIPTING // Monsieur CinΘma + affiche CinΘfil (*************************************************** * Movie importation script for: * * Monsieur CinΘma + affiche CinΘfil * * version 4.6 (c) 2004 scorpion7552 * * grand merci α Antoine Potten pour son aide lors * * de la mise au point de ce script * * * * merci aux auteurs des scripts initiaux * * Monsieur CinΘma, http://cinema.tiscali.fr * * (c) 2002 Antoine Potten antoine@buypin.com * * et * * CinΘfil.com , http://www.cinefil.com * * (c) 2003 Danone-KiD * * * * For use with Ant Movie Catalog 3.4.3 * * www.ant.be.tf/moviecatalog ╖╖╖ www.buypin.com * * * * The source code of the script can be used in * * another program only if full credits to * * script author and a link to Ant Movie Catalog * * website are given in the About box or in * * the documentation of the program * ***************************************************) program MonsieurCinema; const { ImportPicture 0 aucune image importΘe 1 import image MrCinema seule 2 import image Cinefil seule 3 import de toutes les images } ImportPicture = 1; // pour faire plaisir α antp { FullStory True: importer l'histoire complΦte False: importer le rΘsumΘ (s'il existe, sinon import histoire complΦte) } FullStory = False; { ImportAnecdote True: importer l'anecdote α la suite de l'avis de la rΘdaction (commentaires) False: ne pas importer l'anecdote } ImportAnecdote = False; { FullGenerique True: importer le gΘnΘrique complet False: importer le gΘnΘrique de la page essentiel } FullGenerique = False; {ExternalPictures True: Les images seront stockΘes en tant que fichiers dans le mΩme dossier que le catalogue False: Les images seront stockΘes dans le catalogue (seulement pour les fichiers .amc) } ExternalPictures = False; { Always note: la remise α vide d'un champ ne fonctionne pas avec amc 3.4.3 sera corrigΘ dans amc 3.5 False: Θcrire les champs seulement si la valeur lue est non vide True: Θcrire les champs dans tous les cas (sauf affiche) } Always = False; // fin des paramΦtres user MrCinemaUrl = 'http://cinema.tiscali.fr/'; MrCinemaUrlFilm = MrCinemaUrl + 'fichefilm.aspx'; MrCinemaUrlLook = MrCinemaUrl + 'recherche.aspx?file=http&filtre=titre&keys='; CinefilBase = 'http://www.cinefil.com'; CinefilUrl = CinefilBase + '/cinefil2005/'; crlf = #13#10; // pour mode debug debug = False; // mode debug on/off debugrep = 'd:\temp\'; // rΘpertoire de stockage des fichiers var MovieName, Line, EndStr, msgano: string; viewstate, idhistoire, idavis, idgenerique, idanecdote: string; BeginPos, EndPos: Integer; filmok, FormatUTF8: Boolean; //------------------------------------------------------------------------------ // RECHERCHE DU FILM (Mr CinΘma) //------------------------------------------------------------------------------ procedure AnalyzePageMrCinema(Address: string); var Value, PageFilm, PageNext, PagePrev, urlFilm: String; begin // attention aux positionnements: les textes sont au format UTF-8 // note: actuellement, tous les films sont sur une seule page donc pas de pagenext/prev filmok := False; Line := GetPage(Address); if debug then SavePage(debugrep+'choixMrCinema.txt', Line); // debug Line := ExtrStr(Line, 'Vous effectuez une recherche sur', '<b> Articles </b>'); if Line = '' then begin ShowMessage('Monsieur CinΘma: erreur lecture page de recherche'); exit; end; PickTreeClear; // vide la liste des films PickTreeAdd('Films (Monsieur CinΘma)', ''); urlFilm := '<a href="' + MrCinemaUrlFilm+'?id='; repeat // mΘmo des films de cette page (if any) BeginPos := Pos(urlFilm, Line); if BeginPos > 0 then // 1 film trouvΘ begin filmok := True; // flag film(s) trouvΘ(s) Delete(Line, 1, BeginPos - 1); // vire tout avant <a href= Value := ExtrStr(Line, '', '<br>'); // Value = rΘfΘrence courante Line := EndStr; // Line = la suite PageFilm := GetUrl(urlFilm, Value, ''); // inclut &file=http PickTreeAdd(FormatText(Value), PageFilm); end; until BeginPos = 0; // end repeat if not(filmok) then begin ShowMessage('Monsieur CinΘma: Aucun film trouvΘ pour "' + MovieName + '"') exit; end; filmok := False; // remet α False jusqu'α la sΘlection if PageNext <> '' then PickTreeAdd(' >> Page suivante', PageNext); if PickTreeExec(Address) then begin if (Address = PageNext) or (Address = PagePrev) then AnalyzePageMrCinema(Address) // page suivante/prΘcΘdente (if any) else begin SetField(fieldURL, Address); AnalyzeMoviePageMrCinema(Address); // page film end; end else ShowMessage('Monsieur CinΘma: aucune page sΘlectionnΘe'); end; //------------------------------------------------------------------------------ // ANALYSE DE LA PAGE DU FILM (Mr CinΘma) //------------------------------------------------------------------------------ procedure AnalyzeMoviePageMrCinema(Address: string); var Fullpage, PageEssentiel, PageHistoire, PageAvis, PageGenerique, PageAnecdote: string; Value, Value2: string; titreo, titret, realisateur, annee, producteur, duree, acteurs: string; begin // attention aux positionnements: les textes sont au format UTF-8 Fullpage := GetPage(Address); // charge la 1Φre page ("l'essentiel") if debug then SavePage(debugrep+'filmMrCinema.txt', Fullpage); // debug if Pos('<b>L''essentiel</b>', Fullpage) = 0 then Begin ShowMessage('Monsieur CinΘma: erreur lecture page film'); exit; end; filmok := True; // τa y est, c'est bon GetSubParms(Fullpage); // rΘcupΦre les identifiants des pages secondaires // infos utiles de la page "essentiel" PageEssentiel := ExtrStr(Fullpage, '', '</form>'); //********** gΘnΘrique //*** les infos du gΘnΘrique sont plus ou moins valorisΘes // si gΘnΘrique complet demandΘ if (FullGenerique) and (idgenerique <> '') then begin PageGenerique := GetSubPage(Address, idgenerique, 'generiqueMrCinema'); // titre Original/traduit titret := ExtrStr(PageGenerique, '<b class="sous_titre">', '</b>'); titreo := ExtrStr(PageGenerique, '<span class="sous_titre">', '</span>'); // sΘparer les 2 tables Value := ExtrStr(PageGenerique, '<TABLE WIDTH=100%>', '</TABLE>'); // table des infos gΘnΘrales acteurs := ExtrStr(EndStr, '<TABLE WIDTH=100%>', '</TABLE>'); // table des r⌠les/acteurs // acteurs acteurs := FormatTable(acteurs); acteurs := StringReplace(acteurs, '|', '-'); // infos gΘnΘrales // si pas de sΘparateur de champs, alors on prend le mot suivant // d'o∙ la recherche sur des mots 'incomplets' (et en plus, τa permet de couvrir plus de cas...) // pas trΦs stricts dans leur codage, chez Mr CinΘma !!!! Value := FormatTable(Value); // rΘalisateur et annΘe realisateur := ExtrStr(Value, 'R├⌐alis', crlf); // rΘalisation, rΘalisateur, rΘalisΘ,... BeginPos := Pos('|', realisateur); if BeginPos = 0 then BeginPos := Pos(' ', realisateur); realisateur := Copy(realisateur, BeginPos +1, length(realisateur)); annee := ExtrStr(realisateur, '(', ')'); // rq: pas toujours valorisΘe realisateur := ExtrStr(realisateur,'', '('); // producteur producteur := ExtrStr(Value, 'Produ', crlf); // produit, production BeginPos := Pos('|', producteur); if BeginPos = 0 then BeginPos := Pos(' ', producteur); producteur := Copy(producteur, BeginPos +1, length(producteur)); // durΘe duree := ExtrStr(Value, 'Dur├⌐', crlf); // durΘe, durΘes (oui, j'ai vu τa !!!) BeginPos := Pos('|', duree); if BeginPos = 0 then BeginPos := Pos(' ', duree); duree := Copy(duree, BeginPos +1, length(duree)); duree := ExtrStr(duree, '', 'minutes'); end; // si pas de gΘnΘrique complet ou champs non trouvΘs, on essaie dans la page 'essentiel' // titre Original/traduit if titret = '' then titret := ExtrStr(PageEssentiel, '<b class="sous_titre">', '</b>'); if titreo = '' then titreo := ExtrStr(PageEssentiel, '<span class="sous_titre">', '</span>'); // rΘalisateur Value := ExtrStr(PageEssentiel, '<br>', ''); if realisateur = '' then realisateur := ExtrStr(Value, 'de', '</a>'); // annΘe if annee = '' then begin annee := ExtrStr(Value, '</a>', 'avec'); annee := ExtrStr(annee, '(', ')'); end; // acteurs if acteurs = '' then begin acteurs := ExtrStr(Value, 'avec', '<div'); acteurs := StringReplace(acteurs, ', ...', ''); // je ne sais pas si τa existe encore end; // (pas d'info 'producteur' dans la page 'essentiel') //********** mise α jour des champs du gΘnΘrique // titre original et traduit titret := FormatText(titret); // titre traduit ou original titreo := StringReplace(titreo, '(', ''); titreo := StringReplace(titreo, ')', ''); titreo := FormatText(titreo); // original ou '' if (titreo = '') or (titreo = titret) then // 1er titre = original begin // rq: pas de test Always SetField(fieldOriginalTitle, titret); SetField(fieldTranslatedTitle, ''); end else begin // traduit + original SetField(fieldOriginalTitle, titreo); SetField(fieldTranslatedTitle, titret); end; // rΘalisateur realisateur := FormatText(realisateur); if (realisateur <> '') or Always then SetField(fieldDirector, realisateur); // annΘe if (annee <> '') or Always then SetField(fieldYear, annee); // producteur producteur := FormatText(producteur); if (producteur <> '') or Always then SetField(fieldProducer, producteur); // acteurs acteurs := FormatText(acteurs); if (acteurs <> '') or Always then SetField(fieldActors, acteurs); // durΘe: SetField fait plus tard //********** Description (rΘsumΘ ou histoire complΦte) Value := ExtrStr(PageEssentiel, '<div align="justify">', '</div>'); // rΘsumΘ if (Value = '') or (Fullstory and (idhistoire <> '')) then begin // pas de rΘsumΘ ou histoire complΦte demandΘe PageHistoire := GetSubPage(Address, idhistoire, 'histoireMrCinema'); Value := ExtrStr(PageHistoire, '<div align="justify">', '</div>'); end; Value := FormatText(Value); if (Value <> '') or Always then SetField(fieldDescription, Value); //********** avis de la rΘdaction, note (peuvent Ωtre dans la page "essentiel") + anecdote Value := ''; PageAvis := ExtrStr(Fullpage, '<b>L''avis de la r├⌐daction</b>' , ''); if (PageAvis = '') and (idavis <> '') then // avis sur autre page PageAvis := GetSubPage(Address, idavis, 'avisMrCinema'); Value := ExtrStr(PageAvis, '<div align="justify"><p>', '</div>'); Value := FormatText(Value); // Value = avis de la rΘdaction Value2 := ExtrStr(PageAvis, '<img src="img/', 'redac.gif"'); // note 0 α 9 ou '' if (Pos('<b>Aucun avis de la redaction.</b>', PageAvis) > 0) and (Value2 = '0') then Value2 := ''; // pas d'avis et img = 0redac.gif alors ignorer if Value2 <> '' then Value2 := IntToStr(StrToInt(Value2, 0) * 2); // note = 2 * x if (Value2 <> '') or (Always) then // note SetField(fieldRating, Value2); // on ajoute l'anecdote si demandΘ et existant if (ImportAnecdote) and (idanecdote <> '') then begin PageAnecdote := GetSubPage(Address, idanecdote, 'anecdoteMrCinema'); Value2 := ExtrStr(PageAnecdote, '<div align="justify">', '</div>'); Value2 := FormatText(Value2); if Value2 <> '' then begin if Value <> '' then Value := Value + crlf + crlf; Value := Value + 'Anecdote' + crlf + Value2; end; end; if (Value <> '') or Always then SetField(fieldComments, Value); //********** hors zone dynamique // genre Value := ExtrStr(Fullpage, '<b>Genre</b></div>', '</div>'); Value := FormatText(Value); if (Value <> '') or Always then SetField(fieldCategory, Value); // durΘe (sauf si dΘjα fait) if duree = '' then begin duree := ExtrStr(Fullpage, '<b>Dur├⌐e</b></div>', '</div>'); duree := FormatText(duree); // format hh:mm:ss α transformer en minutes if duree <> '' then duree := IntToStr(StrToInt(Copy(duree, 1, 2), 0) * 60 + StrToInt(Copy(duree, 4, 2), 0)); end; if (duree <> '') or Always then SetField(fieldLength, duree); // pays Value := ExtrStr(Fullpage, '<b>Pays </b></div>', '</span>'); Value := FormatText(Value); if (Value <> '') or Always then // pas toujours trΦs cohΘrents les noms de pays... Value := StringReplace(Value, 'Usa', 'Etats-unis'); Value := StringReplace(Value, 'U.s.a', 'Etats-unis'); Value := StringReplace(Value, 'usa', 'Etats-unis'); Value := StringReplace(Value, 'Etats unis', 'Etats-unis'); Value := StringReplace(Value, 'Grande-bretagne', 'Grande bretagne'); SetField(fieldCountry, Value); //********** image si demandΘe (pas de test Always) if (ImportPicture = 1) or (ImportPicture = 3) then begin Value := ExtrStr(Fullpage, '<div style="border-left:1px solid #ffffff;border-right:1px solid #ffffff;">', '<br>'); Value := ExtrStr(Value, '<img src="', '"'); if Value <> '' then GetPicture(Value, ExternalPictures); end; end; //------------------------------------------------------------------------------ // RECHERCHE DU FILM (cinΘfil) //------------------------------------------------------------------------------ procedure AnalyzePageCinefil(Address: string); var Page: TStringList; Value,Value2,page_film,titre_film, annee_film,PagePrev,PageNext: string; begin filmok := False; msgano := ''; PickTreeClear; //vide la liste des films PickTreeAdd('Films (CinΘfil)', ''); Line := GetPage(Address); if debug then SavePage(debugrep+'choixCinefil.txt', Line); // debug Value := ExtrStr(Line, '<B> RΘsultat ', '</B>'); if Value = '' then begin msgano := 'erreur lecture page de recherche'; // non trouvΘ = erreur exit; end; if Copy(Value, 1, 1) = '0' then // 0 = aucun film begin msgano := 'aucun film trouvΘ: essayez autre chose'; exit; end; // recherche pages prΘcΘdente et suivante Line := ExtrStr(Line, 'RΘsultat', ''); Value := ExtrStr(Line, '', '</TD>'); // Value = les url des pages if Pos('HREF', UpperCase(Value)) = 0 then Value := ''; // 1 seule page while Value <> '' do begin Value2 := ExtrStr(Value, '', '/a>'); // Value2 = url page xxx Delete(Value, 1, Pos('</a>', Value)+4); // Value = les suivantes // ignorer les "retours rapides" (<< et >>) pour ne pas confondre avec < et > if Pos('><<<', Value2) > 0 then continue; if Pos('>>><', Value2) > 0 then continue; if Pos('><<', Value2) > 0 then begin // Value2 = url page prΘcΘdente PagePrev := GetUrl('', Value2, CinefilBase); PickTreeAdd('<<< page prΘcΘdente', PagePrev); end; if Pos('>><', Value2) > 0 then PageNext := GetUrl('', Value2, CinefilBase); // Value2 = url page suivante end; // end do while value <> '' // mΘmo des films de cette page Value := '<font class=noir>'; // sΘparateur de films repeat // cherche le lien de la page du film BeginPos := Pos(Value, Line); // description film if BeginPos > 0 then // 1 film trouvΘ begin Delete(Line, 1, BeginPos-1); // url de la page page_film := GetUrl('HREF=''../fichefilm.cfm?ref=', Line, CinefilUrl); // annΘe annee_film := FormatText(ExtrStr(Line, Value, ' ')); // nom du film et rΘalisateur BeginPos := Pos('TITLE="', UpperCase(Line)); Delete(Line, 1, BeginPos); titre_film := ExtrStr(Line, '">', '</TD>'); titre_film := StringReplace(titre_film, '</a>', ','); // titre, rΘalisateur titre_film := FormatText(titre_film); // ajoute le film PickTreeAdd(titre_film + ' ' + annee_film , page_film); end; until BeginPos = 0; if PageNext <> '' then PickTreeAdd('>>> page suivante', PageNext); if PickTreeExec(Address) then begin if (Address = PageNext) or (Address = PagePrev) then AnalyzePageCinefil(Address) // page suivante/prΘcΘdente else AnalyzePageFilmCinefil(Address); // page film end else msgano := 'Vous n''avez rien sΘlectionnΘ'; end; //------------------------------------------------------------------------------ // ANALYSE DE LA PAGE DU FILM (CinΘfil) //------------------------------------------------------------------------------ procedure AnalyzePageFilmCinefil(Address: string); var Value,Value2,Value3,img: string; begin filmok := True; Line := GetPage(Address); Line := ExtrStr(Line, 'RΘfΘrence film cinefil', ''); // vire le dΘbut if debug then SavePage(debugrep+'filmCinefil.txt', Line); // debug // rq: pas de test Always // image: test s'il y a un grand format img := ExtrStr(Line, 'javascript:ZoomPhoto(''', ''''); if img = '' then // sinon test s'il y a un petit format img := ExtrStr(Line, '<IMG class=photo SRC=''', ''''); if img <> '' then GetPicture(img, ExternalPictures) else ShowMessage('CinΘfil: pas d''affiche prΘvue pour "' + MovieName + '"'); end; //------------------------------------------------------------------------------ // formatage d'un texte pour affichage // suppression des tags html, remplacement des caractΦres bizarres //------------------------------------------------------------------------------ function FormatText(str1: string) :string; var s: string; begin if FormatUTF8 then str1 := UTF8Decode(str1); // UTF-8 en ASCII // les caractΦres spΘciaux (pour Θviter de confondre avec les tags HTML) str1 := StringReplace(str1, '&', '&'); str1 := StringReplace(str1, '<', '<'); str1 := StringReplace(str1, '>', '>'); str1 := StringReplace(str1, '"', '"'); // dΘbut et fin de paragraphe = retour α la ligne str1 := StringReplace(str1, '</p>', crlf); str1 := StringReplace(str1, '<p>', crlf); HTMLRemoveTags(str1); // supprime les tags HTML HTMLDecode(str1); // et les caractΦres spΘciaux // supprimer les caractΦres de formatage en dΘbut de chaine (code ASCII <= x'20') repeat s := Copy(str1, 1, 1); // 1er caractΦre de str1 if s <= #32 then Delete(str1, 1, 1); // on le vire until (s = '') or (s > #32); // et on supprime les doubles crlf str1 := StringReplace(str1, crlf+crlf, crlf); // correction des caractΦres ASCII Θtendu qui passent mal // probablement un pb de police car c'est OK avec ShowMessage // ranges x'81' α x'90' et x'93' α x'9F' // les caractΦres non translatΘs sont des caractΦres rarissimes !!!! str1 := StringReplace(str1, chr(130), ','); str1 := StringReplace(str1, chr(132), ',,'); str1 := StringReplace(str1, chr(133), '...'); str1 := StringReplace(str1, chr(136), '^'); // ouais str1 := StringReplace(str1, chr(139), '<'); str1 := StringReplace(str1, chr(140), 'OE'); str1 := StringReplace(str1, chr(147), chr(171)); // quotes ouvrantes str1 := StringReplace(str1, chr(148), chr(187)); // quotes fermantes str1 := StringReplace(str1, chr(150), '-'); str1 := StringReplace(str1, chr(151), '--'); str1 := StringReplace(str1, chr(152), '"'); str1 := StringReplace(str1, chr(155), '>'); str1 := StringReplace(str1, chr(156), 'oe'); // fin des corrections de caractΦres result := Trim(str1); end; //------------------------------------------------------------------------------ // formatage d'une table (MrCinΘma-gΘnΘrique) //------------------------------------------------------------------------------ function FormatTable(str1: string) :string; var sepcel: string; begin // structure table // <TR ...> = dΘbut de ligne // <TD ...> texte </TD> = 1 cellule // </TR> = fin de ligne str1 := StringReplace(str1, crlf, ''); // supprimer les crlf str1 := StringReplace(str1, '<TR>', crlf); // dΘbut de ligne = crlf str1 := StringReplace(str1, '<TR ', crlf+'<'); str1 := StringReplace(str1, '<TD>', '|'); // cellule du 'milieu' str1 := StringReplace(str1, '<TD ', '░<'); // 1Φre cellule HTMLRemoveTags(str1); // supprimer les autres tags str1 := StringReplace(str1, '░'+crlf, ''); // supprimer les lignes vides // dΘterminer le 1er sΘparateur de cellule // crlf░ = <TR><TD ...>texte // crlf░| = <TR><TD ...></TD><TD>texte // et le remplacer par crlf (α priori seuls cas possibles) sepcel := crlf+'░|'; if Pos(sepcel, str1) <> 1 then sepcel := crlf+'░'; str1 := StringReplace(str1, sepcel, crlf); // s'il reste des crlf|| ou crlf|, il s'agit de continuations de lignes str1 := StringReplace(str1, crlf+'||', ' '); // 1 blanc pour ne pas coller au prΘcΘdent str1 := StringReplace(str1, crlf+'|', ' '); str1 := StringReplace(str1, '||', '|'); // supprimer les cellules vides str1 := StringReplace(str1, '||', '|'); // oui, c'est voulu str1 := StringReplace(str1, '|', ' | '); // decoller les sΘparateurs du texte str1 := StringReplace(str1, ' ', ' '); // virer les boubles blancs str1 := StringReplace(str1, '░', ''); // et celui qui reste result := str1; // le crlf en tΩte, il sera supprimΘ dans FormatText end; //------------------------------------------------------------------------------ // formatage du nom de film // les moteurs n'aiment pas les caractΦres accentuΘs, les apostrophes, la ponctuation //------------------------------------------------------------------------------ function FormatMovieName(str1: string) :string; begin // str1 est en ASCII dans tous les cas str1 := AnsiLowerCase(str1); // en minuscules str1 := StringReplace(str1, '''', ' '); str1 := StringReplace(str1, '"', ' '); str1 := StringReplace(str1, '.', ''); str1 := StringReplace(str1, '!', ''); str1 := StringReplace(str1, '?', ''); str1 := StringReplace(str1, ',', ' '); str1 := StringReplace(str1, '-', ' '); str1 := StringReplace(str1, ':', ' '); str1 := StringReplace(str1, ';', ' '); str1 := StringReplace(str1, '/', ' '); str1 := StringReplace(str1, 'α', 'a'); str1 := StringReplace(str1, 'Σ', 'a'); str1 := StringReplace(str1, 'Γ', 'a'); str1 := StringReplace(str1, 'τ', 'c'); str1 := StringReplace(str1, 'Θ', 'e'); str1 := StringReplace(str1, 'Φ', 'e'); str1 := StringReplace(str1, 'δ', 'e'); str1 := StringReplace(str1, 'Ω', 'e'); str1 := StringReplace(str1, '∩', 'i'); str1 := StringReplace(str1, '⌠', 'o'); str1 := StringReplace(str1, '∙', 'u'); str1 := StringReplace(str1, 'ⁿ', 'u'); str1 := StringReplace(str1, '√', 'u'); result := str1; end; //------------------------------------------------------------------------------ // extraction d'une url contenue dans une chaine de caractΦres sans Θdition // adr := GetUrl(texte_HREF_cherchΘ,chaine,url_de_base) //------------------------------------------------------------------------------ function GetUrl(strfrom,str1,urlb: string) :string; var i: Integer; delim: String; begin if strfrom <> '' then // si from = '' on part du dΘbut begin i := Pos(strfrom, str1); // position href cherchΘ if i = 0 then // rien trouvΘ begin result := ''; exit; end; Delete(str1,1, i -1); end; i := Pos('HREF=', UpperCase(str1)); // debut url: href= delim := Copy(str1, i+5, 1); // dΘlimiteur = " ou ' Delete(str1,1, i +5); i := Pos(delim, str1); if i > 0 then Delete(str1,i, Length(str1)); str1 := StringReplace(str1, '&', '&'); str1 := StringReplace(str1, '../', ''); // cf adresse relative str1 := StringReplace(str1, './', ''); str1 := urlb + str1; // ajoute url de base result := Trim(str1); end; //------------------------------------------------------------------------------ // extraction de la chaine dΘlimitΘe par strfrom et strto dans str1 // en sortie: variable globale EndStr = fin de la chaine α partir de strto //------------------------------------------------------------------------------ function ExtrStr(str1,strfrom,strto: string) :string; var i: Integer; begin EndStr := ''; if strfrom <> '' then // si from = '' on part du dΘbut begin i := Pos(strfrom, str1); if i = 0 then // from non trouvΘ begin result := ''; exit; end; Delete(str1, 1, i + Length(strfrom) -1); end; i := Pos(strto, str1); // fin de la chaine EndStr := Copy(str1, i, Length(str1)); Delete(str1, i, Length(str1)); result := Trim(str1); end; //------------------------------------------------------------------------------ // rΘcupΘration des identifiants 'sous-pages' (MrCinema) // GetSubParms(page) //------------------------------------------------------------------------------ procedure GetSubParms(s: string); var Value: string; begin Value := ExtrStr(s, '', '</TD></TR>'); // infos utiles if Pos('doPostBack', Value) > 0 then begin // formulaire et PostPage // rΘcupΦre le paramΦtre VIEWSTATE (ident de session) viewstate := ExtrStr(s, 'name="__VIEWSTATE"', '/>'); viewstate := ExtrStr(viewstate, 'value="', '"'); // c'est un peu trop cablΘ: ordre et __EVENTARGUMENT='': serait mieux si c'Θtait plus prΘcis // page histoire idhistoire := ExtrStr(Value, '__doPostBack(''', ''''); Value := EndStr; if idhistoire <> '' then begin idhistoire := StringReplace(idhistoire, '$', ':'); idhistoire := '__EVENTTARGET='+ idhistoire + '&__EVENTARGUMENT=&__VIEWSTATE=' + viewstate; end; // page avis de la rΘdaction idavis := ExtrStr(Value, '__doPostBack(''', ''''); Value := EndStr; if idavis <> '' then begin idavis := StringReplace(idavis, '$', ':'); idavis := '__EVENTTARGET='+ idavis + '&__EVENTARGUMENT=&__VIEWSTATE=' + viewstate; end; // page gΘnΘrique idgenerique := ExtrStr(Value, '__doPostBack(''', ''''); Value := EndStr; if idgenerique <> '' then begin idgenerique := StringReplace(idgenerique, '$', ':'); idgenerique := '__EVENTTARGET='+ idgenerique + '&__EVENTARGUMENT=&__VIEWSTATE=' + viewstate; end; // page anecdote idanecdote := ExtrStr(Value, '__doPostBack(''', ''''); if idanecdote <> '' then begin idanecdote := StringReplace(idanecdote, '$', ':'); idanecdote := '__EVENTTARGET='+ idanecdote + '&__EVENTARGUMENT=&__VIEWSTATE=' + viewstate; end; end else begin // url normale // page histoire idhistoire := ExtrStr(Value,'', '</a>'); Value := EndStr; idhistoire := GetUrl('', idhistoire, MrCinemaUrlFilm); // page avis de la rΘdaction idavis := ExtrStr(Value,'<TD>', '</a>'); Value := EndStr; idavis := GetUrl('<TD>', idavis, MrCinemaUrlFilm); // page gΘnΘrique idgenerique := ExtrStr(Value,'<TD>', '</a>'); Value := EndStr; idgenerique := GetUrl('', idgenerique, MrCinemaUrlFilm); // page anecdote idanecdote := ExtrStr(Value,'<TD>', '</a>'); idanecdote := GetUrl('', idanecdote, MrCinemaUrlFilm); end; end; //------------------------------------------------------------------------------ // rΘcupΘration des 'sous-pages' (MrCinema) // pagexxx := GetSubPage(adresse_fiche_film, ident_page_cherchΘe, nom_fichier_pour_debug) //------------------------------------------------------------------------------ function GetSubPage(Address, idpage, idfic: string) :string; begin idpage := UrlEncode(idpage); if viewstate = '' then result := GetPage(idpage) else begin // formulaire et PostPage // encore des caractΦres α transformer... aprΦs UrlEncode (ordre trΦs important) idpage := StringReplace(idpage, '+', '%2B'); idpage := StringReplace(idpage, ':', '%3A'); result := PostPage(Address,idpage); end; if debug then SavePage(debugrep+idfic+'.txt', result); // debug // ne garder que la partie dynamique result := ExtrStr(result, '', '</form>'); end; //------------------------------------------------------------------------------ // Θcriture d'une chaine sur disque (pour debug...) // SavePage(chemin_du_fichier,chaine) // chemin_du_fichier = chemin complet ex: 'c:\temp\monfichier.txt' // note: pour bien visualiser l'UTF-8, utiliser un Θditeur genre SciTe //------------------------------------------------------------------------------ procedure SavePage(fic, str1: string); var Page2: TStringList; begin page2 := TStringList.Create; page2.Text := str1; page2.SaveToFile(fic); page2.Free; end; //------------------------------------------------------------------------------ // c'est ici que τa commence //------------------------------------------------------------------------------ begin if CheckVersion(3,4,3) then begin // en rΦgle gΘnΘrale, c'est mieux de passer le nom du film en franτais // Monsieur cinΘma FormatUTF8 := True; // pages au format UTF-8 MovieName := GetField(fieldTranslatedTitle); if MovieName = '' then MovieName := GetField(fieldOriginalTitle); if Input('MonsieurCinΘma.com Import', 'Entrez le titre du film :', MovieName) then begin MovieName := FormatMovieName(MovieName); AnalyzePageMrCinema(MrCinemaUrlLook + UrlEncode(MovieName)); if (ImportPicture = 2) or (ImportPicture = 3) then // si image de cinΘfil demandΘe begin // si filmok = False ou MovieName non valorisΘ c'est que MrCinema n'a rien trouvΘ FormatUTF8 := False; // pages au format ASCII MovieName := GetField(fieldTranslatedTitle); if MovieName = '' then MovieName := GetField(fieldOriginalTitle); if (filmok) and (MovieName <> '') then begin repeat MovieName := FormatMovieName(MovieName); AnalyzePageCinefil(CinefilUrl + 'CFM_Recherches/films.cfm?lachaine2=' + UrlEncode(MovieName)); if not(filmok) then begin // page non trouvΘe ou erreur if not(Input('CinΘfil.com Import', msgano, MovieName)) then filmok := True; // non saisie: on sort end; until filmok; end; // end MovieName ok MrCinema end; // end test ImportPicture if filmok then DisplayResults; end; // end saisie ok MrCinema end else ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.4.3)'); end.